unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  IniFiles, Vcl.StdCtrls, IdTCPConnection, IdTCPClient, IdBaseComponent,
  IdComponent, CcDB,
  IdCustomTCPServer, IdTCPServer, Vcl.Mask, IdContext, IdStrings, Vcl.ComCtrls,
  CcConfStorage, CcReplicator, Data.DB, CcMemDS, CcRplList, CcConf,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf,
  FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async,
  FireDAC.Phys, FireDAC.Comp.Client, CcProviders, CcProvFireDAC, Data.DBXJSON,
  FireDAC.Phys.IBBase, FireDAC.Phys.FB, Vcl.Buttons, System.UITypes,
  FireDAC.Moni.Base, FireDAC.Moni.FlatFile, FireDAC.VCLUI.Wait, FireDAC.Comp.UI,
  IBSQLMonitor, System.StrUtils, FireDAC.VCLUI.Error, NodeJSONUtils,
  Vcl.CheckLst, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,
  FireDAC.DApt, FireDAC.Comp.DataSet, Web.Win.Sockets, OverbyteIcsWndControl,
  OverbyteIcsWSocket, OverbyteIcsWSocketS, OverbyteIcsLogger,
  OverbyteIcsWSocketTS, Vcl.ExtCtrls;

const
  _GetClientType = 'GetClientType';
  _GetDBPath = 'GetDBPath';
  _GetNodeName = 'GetNodeName';
  _GetNodeList = 'GetNodeList';
  _ClientType = 'MyType';
  _ClientEnd = 'End';
  WM_APPSTARTUP = WM_USER + 1;
  WM_LOG_SVR_MESSAGE = WM_USER + 2;
  WM_LOG_CLNT_MESSAGE = WM_USER + 3;

type
  TMyClient = class(TWSocketThrdClient)
  public
    RcvdLine: String;
    ConnectTime: TDateTime;
  end;

  TForm1 = class(TForm)
    CcReplicator1: TCcReplicator;
    CcConfigLocal: TCcConfig;
    CcConnectionLocal: TCcConnectionFireDAC;
    FDConnectionLocal: TFDConnection;
    FDConnectionRemote: TFDConnection;
    CcConnectionRemote: TCcConnectionFireDAC;
    CcConfigRemote: TCcConfig;
    FDPhysFBDriverLink1: TFDPhysFBDriverLink;
    FDMoniFlatFileClientLink1: TFDMoniFlatFileClientLink;
    FDTransactionLocal: TFDTransaction;
    FDTransactionRemote: TFDTransaction;
    FDGUIxWaitCursor1: TFDGUIxWaitCursor;
    OpenDialog1: TOpenDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    GroupBox1: TGroupBox;
    mServerLog: TMemo;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    SpeedButton1: TSpeedButton;
    mClientLog: TMemo;
    btnConnect: TButton;
    btnDisconnect: TButton;
    txtServerIP: TMaskEdit;
    txtServerPort: TEdit;
    txtDBPath: TEdit;
    ProgressBar1: TProgressBar;
    btnStart: TButton;
    Label5: TLabel;
    TabSheet4: TTabSheet;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    ListBox2: TListBox;
    FDGUIxErrorDialog1: TFDGUIxErrorDialog;
    chklsbxLocalTableList: TCheckListBox;
    btnConfigTable: TButton;
    Label6: TLabel;
    chklsbxRemoteTableList: TCheckListBox;
    Button3: TButton;
    fdqLocal: TFDQuery;
    fdqRemote: TFDQuery;
    Button4: TButton;
    chkRemoveNodeOnDisconnect: TCheckBox;
    IcsLogger1: TIcsLogger;
    WSocketThrdServer1: TWSocketThrdServer;
    Panel1: TPanel;
    Label2: TLabel;
    tvNodeList: TTreeView;
    Splitter1: TSplitter;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure txtServerIPExit(Sender: TObject);
    procedure txtServerPortExit(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure CcReplicator1Progress(Sender: TObject);
    procedure IBSQLMonitor1SQL(EventText: string; EventTime: TDateTime);
    procedure tvNodeListMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure tvNodeListDeletion(Sender: TObject; Node: TTreeNode);
    procedure tvNodeListClick(Sender: TObject);
    procedure FDConnectionRemoteError(ASender: TObject;
      const AInitiator: IFDStanObject; var AException: Exception);
    procedure btnConfigTableClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CcReplicator1ConnectLocal(Sender: TObject);
    procedure CcReplicator1ConnectRemote(Sender: TObject);
    procedure CcReplicator1Finished(Sender: TObject);
//    procedure CcReplicator1RowReplicating(Sender: TObject; TableName: string;
//      Fields: TFields; var ReplicateRow, AbortAndTryLater: Boolean);
    procedure Button4Click(Sender: TObject);
    procedure WSocketThrdServer1ClientCreate(Sender: TObject;
      Client: TWSocketClient);
    procedure WSocketThrdServer1ClientConnect(Sender: TObject;
      Client: TWSocketClient; Error: Word);
    procedure WSocketThrdServer1ClientDisconnect(Sender: TObject;
      Client: TWSocketClient; Error: Word);
    procedure WSocketThrdServer1BgException(Sender: TObject; E: Exception;
      var CanClose: Boolean);
    procedure WSocketThrdServer1ThreadException(Sender: TObject;
      AThread: TWsClientThread; const AErrMsg: string);
    procedure FormDestroy(Sender: TObject);
    procedure WSocketThrdServer1ChangeState(Sender: TObject;
      OldState, NewState: TSocketState);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnConnectClick(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
    procedure txtDBPathExit(Sender: TObject);
    procedure chklsbxRemoteTableListClickCheck(Sender: TObject);
    procedure chklsbxLocalTableListClickCheck(Sender: TObject);
    procedure CcReplicator1RowReplicating(Sender: TObject; TableName: string;
      Fields: TCcMemoryFields; var ReplicateRow, AbortAndTryLater: Boolean);
  private
    { Private declarations }
    FWSocket: TWSocket;
    FInitialized: Boolean;
    FLogListServer: TStringList;
    FLogListClient: TStringList;
    FServerIP: string;
    FServerPort: string;
    FServerDBPath: string;
    FRemoteTableListChanged: boolean;
    FLocalTableListChanged: boolean;

    LocalConnection, RemoteConnection: TCcConnection;
    lastHintNode: TTreeNode;
    // test purpose
    s, c: Integer;
    NodeName: string;
    ClientType: string;
    tmpClientType, tmpClientNodes: string;
    tmpClientNodeName, tmpClientNodeDBPath: string;

    // for Socket Client
    procedure FWSocketSessionConnected(Sender: TObject; ErrCode: Word);
    procedure FWSocketSessionClosed(Sender: TObject; ErrCode: Word);
    procedure FWSocketDataAvailable(Sender: TObject; ErrCode: Word);
    procedure FWSocketChangeState(Sender: TObject;
      OldState, NewState: TSocketState);

    // for Socket Server
    procedure ClientLogMsg(const Msg: String);
    procedure ServerLogMsg(const Msg: String);
    procedure WmLogServerMessage(var Msg: TMessage); message WM_LOG_SVR_MESSAGE;
    procedure WmLogClientMessage(var Msg: TMessage);
      message WM_LOG_CLNT_MESSAGE;
    procedure WMAppStartup(var Msg: TMessage); message WM_APPSTARTUP;
    procedure ClientDataAvailable(Sender: TObject; ErrCode: Word);
    procedure ProcessData(Client: TMyClient);
    procedure ClientBgException(Sender: TObject; E: Exception;
      var CanClose: Boolean);
    procedure ClientLineLimitExceeded(Sender: TObject; Cnt: LongInt;
      var ClearData: Boolean);
    // for node config
    procedure CheckTableConfig(Qry: TFDQuery; CheckListBox: TCheckListBox;
      CcConfig: TCcConfig);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ConfigIni: TIniFile;

  LockDisplay: TRtlCriticalSection;

implementation

{$R *.dfm}

uses
  IdGlobal, OverbyteIcsUtils;

procedure TForm1.btnConfigTableClick(Sender: TObject);
var
  i: Integer;
  configTable: TCcConfigTable;
begin
  if chklsbxLocalTableList.Items.Count = 0 then
  begin
    ShowMessage('Local DB is load yet.');
    exit;
  end;
  if chklsbxRemoteTableList.Items.Count = 0 then
  begin
    ShowMessage('Remote DB is load yet.');
    exit;
  end;
  CcConfigLocal.Tables.Clear;
  for i := 0 to chklsbxLocalTableList.Items.Count - 1 do
  begin
    if chklsbxLocalTableList.Checked[i] then
    begin
      configTable := CcConfigLocal.Tables.Add;
      configTable.TableName := chklsbxLocalTableList.Items[i];
    end;
  end;
  CcConfigRemote.Tables.Clear;
  for i := 0 to chklsbxRemoteTableList.Items.Count - 1 do
  begin
    if chklsbxRemoteTableList.Checked[i] then
    begin
      configTable := CcConfigRemote.Tables.Add;
      configTable.TableName := chklsbxRemoteTableList.Items[i];
    end;
  end;
  CcConfigLocal.Connect;
  CcConfigLocal.GenerateConfig;
  CcConfigRemote.Connect;
  CcConfigRemote.GenerateConfig;

  ShowMessage('Databases configured successfully!');
end;

procedure TForm1.btnConnectClick(Sender: TObject);
begin
  if Assigned(FWSocket) then
    FWSocket.Release; { This will close connection as needed }
  { Create a new TWSocket and initialize all needed properties and events }
  FWSocket := TWSocket.Create(Self);
  FWSocket.Proto := 'tcp';
  FWSocket.Port := Trim(txtServerPort.Text);
  FWSocket.Addr := StringReplace(txtServerIP.Text, ' ', '',
    [rfReplaceAll, rfIgnoreCase]);
  FWSocket.LineMode := TRUE;
  FWSocket.LineEnd := CRLF;
  FWSocket.OnSessionConnected := FWSocketSessionConnected;
  FWSocket.OnSessionClosed := FWSocketSessionClosed;
  FWSocket.OnDataAvailable := FWSocketDataAvailable;
  FWSocket.OnChangeState := FWSocketChangeState;
  FWSocket.IcsLogger := IcsLogger1;
  try
    FWSocket.Connect;
  except
    { Connect may fail because of invalid parameters and will trigger }
    { an exception. }
    on E: Exception do
    begin
      ClientLogMsg(Format('Unabled to connect: %s: %s',
        [E.ClassName, E.Message]));
    end;
  end;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
  if Assigned(FWSocket) then
    FWSocket.Close;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  btnStart.Enabled := False;
  try
    if CcConnectionLocal.Connected then
    begin
      ListBox2.Items.Add(Format('%s: Disconnecting local connection',
        [DateTimeToStr(Now)]));
      Application.ProcessMessages;
      CcConnectionLocal.Disconnect;
    end;
    if CcConnectionRemote.Connected then
    begin
      ListBox2.Items.Add(Format('%s: Disconnecting remote connection',
        [DateTimeToStr(Now)]));
      Application.ProcessMessages;
      CcConnectionRemote.Disconnect;
    end;

    if tvNodeList.Selected.Data <> nil then
    begin
      CcReplicator1.Nodes.LocalNode.Name := Self.NodeName;
      CcReplicator1.Nodes.RemoteNode.Name := PNodeInfo(tvNodeList.Selected.Data)
        ^.NodeName;
      CcReplicator1.Replicate;
    end
    else
    begin
      ShowMessage('No remote node selected.');
    end;
  finally
    btnStart.Enabled := TRUE;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  NodeInfoPtr: PNodeInfo;
  TreeNodeIndex: LongInt;
begin
  Inc(c);
  // TreeView1.Items.AddChild(TreeView1.Selected, 'Client ' + IntToStr(c));
  New(NodeInfoPtr);
  NodeInfoPtr^.NodeName := 'Client ' + IntToStr(c);
  NodeInfoPtr^.NodeType := LeftStr(NodeInfoPtr^.NodeName, 1);
  NodeInfoPtr^.NodeDBPath := 'c:\\data\\db' + IntToStr(c) + '.fdb';
  TreeNodeIndex := tvNodeList.Selected.AbsoluteIndex;
  tvNodeList.Items.AddChildObject(tvNodeList.Items[TreeNodeIndex],
    NodeInfoPtr^.NodeName, NodeInfoPtr);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  NodeInfoPtr: PNodeInfo;
  TreeNodeIndex: LongInt;
begin
  Inc(s);
  // TreeView1.Items.AddChild(TreeView1.Selected, 'Server ' + IntToStr(s));
  New(NodeInfoPtr);
  NodeInfoPtr^.NodeName := 'Server ' + IntToStr(s);
  NodeInfoPtr^.NodeType := LeftStr(NodeInfoPtr^.NodeName, 1);
  NodeInfoPtr^.NodeDBPath := 'c:\\data\\db' + IntToStr(s) + '.fdb';
  TreeNodeIndex := tvNodeList.Selected.AbsoluteIndex;
  tvNodeList.Items.AddChildObject(tvNodeList.Items[TreeNodeIndex],
    NodeInfoPtr^.NodeName, NodeInfoPtr);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  CcConfigLocal.Disconnect;
  FDConnectionLocal.Connected := False;
  FDConnectionLocal.Params.Values['Protocol'] := 'Local';
  FDConnectionLocal.Params.Values['Server'] := '';
  FDConnectionLocal.Params.Values['Database'] := ConfigIni.ReadString('Client',
    'DB Path', '');
  FDConnectionLocal.Connected := TRUE;

  // CcConfigRemote.Connect;
  if not LocalConnection.Connected then
    LocalConnection.Connect;
  chklsbxLocalTableList.Items.Clear;
  chklsbxLocalTableList.Items.Assign(LocalConnection.ListTables);
  CheckTableConfig(fdqLocal, chklsbxLocalTableList, CcConfigLocal);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to chklsbxLocalTableList.Items.Count - 1 do
  begin
    if chklsbxLocalTableList.Checked[i] then
      CcConfigLocal.RemoveTriggers(chklsbxLocalTableList.Items[i]);
  end;
  for i := 0 to chklsbxRemoteTableList.Items.Count - 1 do
  begin
    if chklsbxRemoteTableList.Checked[i] then
      CcConfigRemote.RemoveTriggers(chklsbxRemoteTableList.Items[i]);
  end;
end;

procedure TForm1.CheckTableConfig(Qry: TFDQuery; CheckListBox: TCheckListBox;
  CcConfig: TCcConfig);
var
  i: Integer;
begin
  with Qry do
  begin
    Active := False;
    SQL.Clear;
    SQL.Add(Format
      ('select * from RPL$TABLES_CONFIG where CREATED=''Y'' and CONFIG_NAME=''%s''',
      [CcConfig.ConfigName]));
    if not Prepared then
      Prepare;
    Active := TRUE;
    if RecordCount > 0 then
    begin
      First;
      while not EOF do
      begin
        i := CheckListBox.Items.IndexOf(FieldByName('TABLE_NAME').AsString);
        CheckListBox.Checked[i] := TRUE;
        Next;
      end;
    end;
  end;
end;

procedure TForm1.chklsbxLocalTableListClickCheck(Sender: TObject);
begin
  FLocalTableListChanged := True;
end;

procedure TForm1.chklsbxRemoteTableListClickCheck(Sender: TObject);
begin
  FRemoteTableListChanged := True;
end;

procedure TForm1.CcReplicator1ConnectLocal(Sender: TObject);
begin
  ListBox2.Items.Add(Format('%s: Replicator connecting local db',
    [DateTimeToStr(Now)]));
end;

procedure TForm1.CcReplicator1ConnectRemote(Sender: TObject);
begin
  ListBox2.Items.Add(Format('%s: Replicator connecting remote db',
    [DateTimeToStr(Now)]));
end;

procedure TForm1.CcReplicator1Finished(Sender: TObject);
begin
  ListBox2.Items.Add(Format('%s: Replication finished', [DateTimeToStr(Now)]));
end;

procedure TForm1.CcReplicator1Progress(Sender: TObject);
begin
  EnterCriticalSection(LockDisplay);
  try
    ProgressBar1.Max := CcReplicator1.Log.LineCount;
    ProgressBar1.Position := CcReplicator1.Log.CurrentLine;
    Label7.Caption := Format('%d/%d', [ProgressBar1.Position,
      ProgressBar1.Max]);
  finally
    Application.ProcessMessages;
    LeaveCriticalSection(LockDisplay);
  end;
end;

procedure TForm1.CcReplicator1RowReplicating(Sender: TObject; TableName: string;
  Fields: TCcMemoryFields; var ReplicateRow, AbortAndTryLater: Boolean);
begin
  ListBox2.Items.Add(Format('%s: Replicating table %s - Field %s',
    [DateTimeToStr(Now), TableName, Fields.FieldByIndex[0].AsString]));
end;

{procedure TForm1.CcReplicator1RowReplicating(Sender: TObject; TableName: string;
  Fields: TFields; var ReplicateRow, AbortAndTryLater: Boolean);
begin
end; }

procedure TForm1.FDConnectionRemoteError(ASender: TObject;
  const AInitiator: IFDStanObject; var AException: Exception);
var
  oExc: EFDDBEngineException;
begin
  if AException is EFDDBEngineException then
  begin
    oExc := EFDDBEngineException(AException);
    if oExc.Kind = ekServerGone then
    begin
      FDConnectionRemote.Connected := False;
    end
    else if oExc.Kind = ekRecordLocked then
      oExc.Message :=
        'Please, try the operation later. At moment, the record is busy'
    else if (oExc.Kind = ekUKViolated) and SameText(oExc[0].ObjName,
      'UniqueKey_Orders') then
      oExc.Message :=
        'Please, provide the unique order information. It seems, your order was already put';
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ConfigIni.WriteString('Client', 'Server IP', StringReplace(txtServerIP.Text,
    ' ', '', [rfReplaceAll, rfIgnoreCase]));
  ConfigIni.WriteString('Client', 'Server Port', Trim(txtServerPort.Text));
  ConfigIni.WriteString('Client', 'DB Path', Trim(txtDBPath.Text));
  ConfigIni.UpdateFile;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  IniPath: string;
begin
  FLogListServer := nil;
  FLogListServer := TStringList.Create;
  FLogListClient := nil;
  FLogListClient := TStringList.Create;

  IniPath := ExtractFilePath(Application.ExeName);
  ConfigIni := TIniFile.Create(IniPath + '\config.ini');

  // PageControl1.TabIndex := 0;
  ClientType := ConfigIni.ReadString('Client', 'Type', '');
  if ClientType = '' then
  begin
    ShowMessage('Client Type is not set yet.');
    exit;
  end;
  if (ClientType <> 'C') and (ClientType <> 'S') then
  begin
    ShowMessage('Client Type uses wrong charactor, abort!');
    Application.Terminate;
  end;

  FServerIP := ConfigIni.ReadString('Client', 'Server IP', '127.0.0.1');
  FServerPort := ConfigIni.ReadString('Client', 'Server Port', '2031');
  FServerDBPath := ConfigIni.ReadString('Client', 'DB Path', '');

  txtServerIP.Text := FServerIP;
  txtServerPort.Text := FServerPort;
  txtDBPath.Text := FServerDBPath;

  NodeName := ConfigIni.ReadString('Client', 'Node Name', '');

  LocalConnection := CcConnectionLocal;
  RemoteConnection := CcConnectionRemote;
  CcConfigLocal.Connection := LocalConnection;
  CcConfigRemote.Connection := RemoteConnection;
  CcConfigLocal.Nodes.Text := NodeName;
  CcConfigRemote.Nodes.Text := 'remoteDB';

  // Here we name the two nodes LOCAL and REMOTE
  // You can use any name that has a meaning to you, but it must match the
  // names used above in the list of nodes

  CcReplicator1.LocalNode.Connection := LocalConnection;
  CcReplicator1.LocalNode.Name := 'remoteDB';
  CcReplicator1.RemoteNode.Connection := RemoteConnection;
  CcReplicator1.RemoteNode.Name := 'localDB';
  tvNodeList.Selected := tvNodeList.Items[0];

  // test purpose
  c := 0;
  s := 0;
  PageControl1.TabIndex := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  EnterCriticalSection(LockDisplay);
  try
    if Assigned(FWSocket) then
      FWSocket.Close;
    WSocketThrdServer1.Close;
    CcConfigLocal.Disconnect;
    CcConfigRemote.Disconnect;
    if FDConnectionLocal.Connected then
      FDConnectionLocal.Connected := False;
    if FDConnectionRemote.Connected then
      FDConnectionRemote.Connected := False;

    if Assigned(FLogListServer) then
      FLogListServer.Free;
    if Assigned(FLogListClient) then
      FLogListClient.Free;
  finally
    LeaveCriticalSection(LockDisplay);
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if not FInitialized then
  begin
    FInitialized := TRUE;
    mServerLog.Clear;
    mClientLog.Clear;
    { Delay startup code until our UI is ready and visible }
    PostMessage(Handle, WM_APPSTARTUP, 0, 0);
  end;
end;

procedure TForm1.IBSQLMonitor1SQL(EventText: string; EventTime: TDateTime);
begin
  ShowMessage('Query running');
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if OpenDialog1.Execute(Self.WindowHandle) = TRUE then
  begin
    txtDBPath.Text := OpenDialog1.FileName;
  end;
end;

procedure TForm1.tvNodeListClick(Sender: TObject);
var
  IP, Port: string;
begin
  if tvNodeList.Selected <> nil then
    if tvNodeList.Selected.Data <> nil then
    begin
      IdStrings.SplitString(PNodeInfo(tvNodeList.Selected.Data)^.NodeName, ':',
        IP, Port);
      IP := PNodeInfo(tvNodeList.Selected.Data)^.NodeIP;
      if not FDConnectionRemote.Connected or
        (FDConnectionRemote.Params.Values['Server'] <> IP) then
      begin
        CcConfigRemote.Disconnect;
        FDConnectionRemote.Connected := False;
        FDConnectionRemote.Params.Values['Protocol'] := 'TCPIP';
        FDConnectionRemote.Params.Values['Server'] := IP;
        FDConnectionRemote.Params.Values['Database'] :=
          PNodeInfo(tvNodeList.Selected.Data)^.NodeDBPath;
        FDConnectionRemote.Connected := TRUE;

        CcConfigLocal.Nodes.Text := PNodeInfo(tvNodeList.Selected.Data)
          ^.NodeName;
        CcConfigRemote.Nodes.Text := Self.NodeName;
        // CcConfigRemote.Connect;
        if not RemoteConnection.Connected then
          RemoteConnection.Connect;
        chklsbxRemoteTableList.Items.Clear;
        chklsbxRemoteTableList.Items.Assign(RemoteConnection.ListTables);
        CheckTableConfig(fdqRemote, chklsbxRemoteTableList, CcConfigRemote);
        PageControl1.TabIndex := 1;
      end;
      PageControl1.TabIndex := 1;
    end;
end;

procedure TForm1.tvNodeListDeletion(Sender: TObject; Node: TTreeNode);
begin
  Dispose(Node.Data);
end;

procedure TForm1.tvNodeListMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  tree: TTreeView;
  hoverNode: TTreeNode;
  hitTest: THitTests;
  // ht : THitTest;
  NodeInfoPtr: PNodeInfo;
begin
  if (Sender is TTreeView) then
    tree := TTreeView(Sender)
  else
    exit;
  hoverNode := tree.GetNodeAt(X, Y);
  hitTest := tree.GetHitTestInfoAt(X, Y);
  (* //list the hitTest values
    Caption := '';
    for ht in hitTest do
    begin
    Caption := Caption + GetEnumName(TypeInfo(THitTest), integer(ht)) + ', ';
    end;
  *)
  if (lastHintNode <> hoverNode) then
  begin
    Application.CancelHint;
    if (hitTest <= [htOnItem, htOnIcon, htOnLabel, htOnStateIcon]) then
    begin
      lastHintNode := hoverNode;
      NodeInfoPtr := PNodeInfo(hoverNode.Data);
      if NodeInfoPtr <> nil then
        tree.Hint := Format('Name: %s'#$D#$A'Type: %s'#$D#$A'DB Path: %s'#$D#$A
          + 'IP: %s'#$D#$A'Address: %s', [NodeInfoPtr^.NodeName,
          NodeInfoPtr^.NodeType, NodeInfoPtr^.NodeDBPath, NodeInfoPtr^.NodeIP,
          NodeInfoPtr^.NodeAddress]);
    end;
  end;
end;

procedure TForm1.txtDBPathExit(Sender: TObject);
begin
  FServerDBPath := Trim(txtDBPath.Text);
end;

procedure TForm1.txtServerIPExit(Sender: TObject);
var
  net1, net2, host1, host2: Integer;
  IP: String;

begin
  // Extract the net and host address from the IP.
  IP := txtServerIP.Text;
  net1 := StrToInt(TrimRight(Copy(IP, 0, 3)));
  net2 := StrToInt(TrimRight(Copy(IP, 5, 3)));
  host1 := StrToInt(TrimRight(Copy(IP, 9, 3)));
  host2 := StrToInt(TrimRight(Copy(IP, 13, 3)));

  // A range test that you cannot validate through edit masks.
  if ((net1 < 0) Or (net1 > 255) Or (net2 < 0) Or (net2 > 255) Or (host1 < 0) Or
    (host1 > 255) Or (host2 < 0) Or (host2 > 255)) then
    raise EArgumentException.Create('Invalid IP address.');
  FServerIP := Format('%s.%s.%s.%s', [net1, net2, host1, host2]);
  txtServerIP.Text := FServerIP;
end;

procedure TForm1.txtServerPortExit(Sender: TObject);
var
  Port: Integer;
begin
  Port := StrToInt(txtServerPort.Text);
  if Port > 65535 then
    raise EArgumentException.Create('Invalid port number.');
  FServerPort := Trim(txtServerPort.Text);
end;

procedure TForm1.FWSocketChangeState(Sender: TObject;
  OldState, NewState: TSocketState);
begin
  ClientLogMsg(Format('Client in Status %s', [SocketStateNames[NewState]]));
end;

procedure TForm1.FWSocketDataAvailable(Sender: TObject; ErrCode: Word);
var
  ServerCommand: string;
begin
  { Remember: we use line mode. We will always receive complete lines }
  with Sender as TWSocket do
    ServerCommand := ReceiveStr;
  { Remove trailing CR/LF, if any }
  if (Length(ServerCommand) > 1) and
    (ServerCommand[Length(ServerCommand)] = #10) and
    (ServerCommand[Length(ServerCommand) - 1] = #13) then
    SetLength(ServerCommand, Length(ServerCommand) - 2);
  { ServerLogMsg received line }
  ClientLogMsg(ServerCommand);

  with TWSocket(Sender) do
  begin
    if SameText(ServerCommand, _GetClientType) then
      SendLine(_ClientType + '=' + ClientType)
    else if SameText(ServerCommand, _GetDBPath) then
      SendLine(_GetDBPath + '=' + Trim(txtDBPath.Text))
    else if SameText(ServerCommand, _GetNodeName) then
      SendLine(_GetNodeName + '=' + Self.NodeName)
    else if SameText(ServerCommand, _GetNodeList) then
      SendLine(_GetNodeList + '=' + Node2JSONList(tvNodeList.Items[0]).ToString)
    else if SameText(ServerCommand, _ClientEnd) then
      SendLine(_ClientEnd + '=' + _ClientEnd);
  end;
end;

procedure TForm1.FWSocketSessionClosed(Sender: TObject; ErrCode: Word);
begin
  ClientLogMsg('Session closed.');
  { Destroy the socket. We can't use Destroy here because we are in }
  { an event handler. We need to use Release which will delay destruction }
  { until we are out of the event handler. }
  FWSocket.Release;
  FWSocket := nil;
  btnConnect.Enabled := TRUE;
  btnDisconnect.Enabled := False;
end;

procedure TForm1.FWSocketSessionConnected(Sender: TObject; ErrCode: Word);
begin
  if ErrCode <> 0 then
    ClientLogMsg(Format('Can''t connect. Error #%s', [IntToStr(ErrCode)]))
  else
    ClientLogMsg('Session connected.');
  btnConnect.Enabled := False;
  btnDisconnect.Enabled := TRUE;
end;

procedure TForm1.WSocketThrdServer1BgException(Sender: TObject; E: Exception;
  var CanClose: Boolean);
begin
  ServerLogMsg('Server exception occured: ' + E.ClassName + ': ' + E.Message);
  CanClose := False; { Hoping that server will still work ! }
end;

procedure TForm1.WSocketThrdServer1ChangeState(Sender: TObject;
  OldState, NewState: TSocketState);
begin
  ServerLogMsg(Format('Server in Status: %s', [SocketStateNames[NewState]]));
end;

procedure TForm1.WSocketThrdServer1ClientConnect(Sender: TObject;
  Client: TWSocketClient; Error: Word);
begin
  with Client as TMyClient do
  begin
    ServerLogMsg('Client connected.' + ' Remote: ' + PeerAddr + '/' + PeerPort +
      ' Local: ' + GetXAddr + '/' + GetXPort + ' ThrdID : $' +
      IntToStr(ClientThread.ThreadID) + ' ThrdCnt: #' +
      IntToStr(WSocketThrdServer1.ThreadCount) + CRLF + 'There is now ' +
      IntToStr(TWSocketThrdServer(Sender).ClientCount) + ' clients connected.');
    Client.LineMode := TRUE;
    Client.LineEdit := TRUE;
    Client.LineLimit := 255; { Do not accept long lines }
    Client.OnDataAvailable := ClientDataAvailable;
    Client.OnLineLimitExceeded := ClientLineLimitExceeded;
    Client.OnBgException := ClientBgException;
    TMyClient(Client).ConnectTime := Now;
  end;
  ServerLogMsg(Format('Client connected from %s:%s', [Client.PeerAddr,
    Client.PeerPort]));
  ServerLogMsg('Request Client Type');
  Client.SendLine(_GetClientType);
  ServerLogMsg('Request Client DB Path');
  Client.SendLine(_GetDBPath);
  ServerLogMsg('Request Client Node Name');
  Client.SendLine(_GetNodeName);
  ServerLogMsg('Request Client Node List');
  Client.SendLine(_GetNodeList);
  ServerLogMsg('Request End');
  Client.SendLine(_ClientEnd);
end;

procedure TForm1.WSocketThrdServer1ClientCreate(Sender: TObject;
  Client: TWSocketClient);
var
  MyClient: TMyClient;
begin
  MyClient := Client as TMyClient;
  MyClient.LineMode := TRUE;
  MyClient.LineEdit := TRUE;
  MyClient.LineLimit := 255; { Do not accept long lines }
  MyClient.OnDataAvailable := ClientDataAvailable;
  MyClient.OnLineLimitExceeded := ClientLineLimitExceeded;
  MyClient.OnBgException := ClientBgException;
  // TMyClientThread(Cli.ClientThread).OnDisplay := Display;
  MyClient.ConnectTime := Now;
end;

procedure TForm1.WSocketThrdServer1ClientDisconnect(Sender: TObject;
  Client: TWSocketClient; Error: Word);
var
  MyClient: TMyClient;
  ClientThreadID: Integer;
  NodeDisconnected: TTreeNode;
  NodeAddress: string;
begin
  MyClient := Client as TMyClient;
  if Assigned(MyClient.ClientThread) then
    ClientThreadID := MyClient.ClientThread.ThreadID
  else
    ClientThreadID := -1;
  ServerLogMsg('Client disconnecting: ' + MyClient.PeerAddr + '   ' +
    'Duration: ' + FormatDateTime('hh:nn:ss', Now - MyClient.ConnectTime) +
    ' Error: ' + IntToStr(Error) + ' ThrdID: $' + IntToStr(ClientThreadID) +
    ' ThrdCnt: #' + IntToStr(TWSocketThrdServer(Sender).ThreadCount) + CRLF +
    'There is now ' + IntToStr(TWSocketThrdServer(Sender).ClientCount - 1) +
    ' clients connected.');

  NodeAddress := Format('%s:%s', [Client.PeerAddr, Client.PeerPort]);
  ServerLogMsg(Format('Client Node Disconnected: [%s]', [NodeAddress]));
  // RemoteConnection.Disconnect;
  chklsbxRemoteTableList.Clear;
  if chkRemoveNodeOnDisconnect.Checked then
  begin
    NodeDisconnected := GetNodeByText(tvNodeList, NodeAddress);
    if NodeDisconnected <> nil then
    begin
      ServerLogMsg(Format('Client Node [%s] has been removed from Node List',
        [NodeDisconnected.Text]));
      tvNodeList.Items.Delete(NodeDisconnected);
    end;
  end;
end;

procedure TForm1.WSocketThrdServer1ThreadException(Sender: TObject;
  AThread: TWsClientThread; const AErrMsg: string);
begin
  ServerLogMsg(AErrMsg);
end;

procedure TForm1.ServerLogMsg(const Msg: String);
begin
  EnterCriticalSection(LockDisplay);
  try
    FLogListServer.Insert(0, DateTimeToStr(Now) + ' - ' + Msg);
    PostMessage(Handle, WM_LOG_SVR_MESSAGE, 0, 0);
  finally
    LeaveCriticalSection(LockDisplay);
  end;
end;

procedure TForm1.ClientLogMsg(const Msg: String);
begin
  EnterCriticalSection(LockDisplay);
  try
    FLogListClient.Insert(0, DateTimeToStr(Now) + ' - ' + Msg);
    PostMessage(Handle, WM_LOG_CLNT_MESSAGE, 0, 0);
  finally
    LeaveCriticalSection(LockDisplay);
  end;
end;

{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
{ This is our custom message handler. We posted a WM_APPSTARTUP message }
{ from FormShow event handler. Now UI is ready and visible. }
procedure TForm1.WMAppStartup(var Msg: TMessage);
begin
  ServerLogMsg('Sync Client Server started');
  WSocketThrdServer1.Proto := 'tcp'; { Use TCP protocol }
  WSocketThrdServer1.Port := FServerPort; { Use telnet port }
  WSocketThrdServer1.Addr := '0.0.0.0'; { Use any interface }
  WSocketThrdServer1.ClientClass := TMyClient; { Use our component }
  WSocketThrdServer1.Listen; { Start listening }
  ServerLogMsg('Waiting for clients...');
end;

procedure TForm1.ClientLineLimitExceeded(Sender: TObject; Cnt: LongInt;
  var ClearData: Boolean);
begin
  with Sender as TMyClient do
  begin
    ServerLogMsg('Line limit exceeded from ' + GetPeerAddr + '. Closing.');
    ClearData := TRUE;
    Close;
  end;
end;

procedure TForm1.ClientDataAvailable(Sender: TObject; ErrCode: Word);
var
  Cli: TMyClient;
begin
  Cli := Sender as TMyClient;
  { We use line mode. We will receive complete lines }
  Cli.RcvdLine := Cli.ReceiveStr;
  { Remove trailing CR/LF }
  while (Length(Cli.RcvdLine) > 0) and
    IsCharInSysCharSet(Cli.RcvdLine[Length(Cli.RcvdLine)], [#13, #10]) do
    Cli.RcvdLine := Copy(Cli.RcvdLine, 1, Length(Cli.RcvdLine) - 1);
  ServerLogMsg('Received from ' + Cli.GetPeerAddr + ': ''' +
    Cli.RcvdLine + '''');
  ProcessData(Cli);
end;

procedure TForm1.ProcessData(Client: TMyClient);
var
  ReceivedFromClient, ClientRespond: string;
  ServerCommand: string;
  TreeNode: TTreeNode;
  JSONObject: TJSONObject;
  NodeInfoPtr: PNodeInfo;
  TreeNodeIndex: LongInt;
begin
  ReceivedFromClient := Client.RcvdLine;
  IdStrings.SplitString(ReceivedFromClient, '=', ServerCommand, ClientRespond);
  if SameText(ServerCommand, _ClientType) then
  begin
    tmpClientType := ClientRespond;
    ServerLogMsg(Format('Received Client Type: [%s]', [tmpClientType]));
  end
  else if SameText(ServerCommand, _GetDBPath) then
  begin
    tmpClientNodeDBPath := ClientRespond;
    ServerLogMsg(Format('Received Client DB Path: [%s]',
      [tmpClientNodeDBPath]));
  end
  else if SameText(ServerCommand, _GetNodeName) then
  begin
    tmpClientNodeName := ClientRespond;
    ServerLogMsg(Format('Received Client Node Name: [%s]',
      [tmpClientNodeName]));
  end
  else if SameText(ServerCommand, _GetNodeList) then
  begin
    tmpClientNodes := ClientRespond;
    ServerLogMsg(Format('Received Client Node List: [%s]', [tmpClientNodes]));
  end
  else if SameText(ServerCommand, _ClientEnd) then
  begin
    ServerLogMsg('Received End command');
    ServerLogMsg('tmpClientNodeName=' + tmpClientNodeName);
    ServerLogMsg('tmpClientType=' + tmpClientType);
    ServerLogMsg('tmpClientNodeDBPath=' + tmpClientNodeDBPath);
    ServerLogMsg('tmpClientNodes=' + tmpClientNodes);
    New(NodeInfoPtr);
    with NodeInfoPtr^ do
    begin
      NodeIP := Client.PeerAddr;
      NodeAddress := Format('%s:%s', [NodeIP, Client.PeerPort]);
      NodeName := tmpClientNodeName;
      NodeType := tmpClientType;
      NodeDBPath := tmpClientNodeDBPath;
    end;
    TreeNodeIndex := tvNodeList.Items[0].AbsoluteIndex;
    TreeNode := tvNodeList.Items.AddChildObject(tvNodeList.Items[TreeNodeIndex],
      tmpClientNodeName, NodeInfoPtr);
    ServerLogMsg('Client Node added in the Node List');
    if tmpClientType = 'S' then
    begin
      // convert JSON string to JSON object
      JSONObject := TJSONObject.ParseJSONValue
        (TEncoding.ASCII.GetBytes(tmpClientNodes), 0) as TJSONObject;
      JSONList2Node(tvNodeList, JSONObject, TreeNode);
      ServerLogMsg(Format('Client Node List added under the Node: [%s]',
        [tmpClientNodeName]));
    end;
  end;
end;

{ This event handler is called when a client socket experience a background }
{ exception. It is likely to occurs when client aborted connection and data }
{ has not been sent yet. }
procedure TForm1.ClientBgException(Sender: TObject; E: Exception;
  var CanClose: Boolean);
begin
  with Sender as TMyClient do
  begin
    ServerLogMsg('Client exception occured: ' + E.ClassName + ': ' + E.Message);
    CanClose := TRUE; { Goodbye client ! }
  end;
end;

{ Display a message in our display memo. Delete lines to be sure to not }
{ overflow the memo which may have a limited capacity. }
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
procedure TForm1.WmLogServerMessage(var Msg: TMessage);
var
  i: Integer;
begin
  mServerLog.Lines.BeginUpdate;
  try
    if mServerLog.Lines.Count > 200 then
    begin
      for i := 1 to 50 do
        mServerLog.Lines.Delete(0);
    end;
    EnterCriticalSection(LockDisplay);
    try
      mServerLog.Lines.AddStrings(FLogListServer);
      FLogListServer.Clear;
    finally
      LeaveCriticalSection(LockDisplay);
    end;
  finally
    mServerLog.Lines.EndUpdate;
    mServerLog.Perform(EM_SCROLLCARET, 0, 0);
  end;
end;

procedure TForm1.WmLogClientMessage(var Msg: TMessage);
var
  i: Integer;
begin
  mClientLog.Lines.BeginUpdate;
  try
    if mClientLog.Lines.Count > 200 then
    begin
      for i := 1 to 50 do
        mClientLog.Lines.Delete(0);
    end;
    EnterCriticalSection(LockDisplay);
    try
      mClientLog.Lines.AddStrings(FLogListClient);
      FLogListClient.Clear;
    finally
      LeaveCriticalSection(LockDisplay);
    end;
  finally
    mClientLog.Lines.EndUpdate;
    mClientLog.Perform(EM_SCROLLCARET, 0, 0);
  end;
end;

initialization

InitializeCriticalSection(LockDisplay);

{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
finalization

DeleteCriticalSection(LockDisplay);

end.
